SEARCH HDRFIL
COMPIL(LOR,<SAILOR,.SEG2.>
	    ,<%UUOLNK,%ALLOC,%SPGC,%STRMRK,%ARRSRT,K.OUT,$PDLOV,P.FIN>
	    ,<BASE DATA, INITIALIZATION CONTROL>
	    ,<X11,X22,X33,X44>,INHIBIT)
SUBTTL	Base (Low Segment) Data Descriptions - Params, Links, Size specs
XX	(GOGTAB,0,INTERNAL)	;PTR TO USER TABLE
XX	(DATM,0,INTERNAL)	;XWD 3,ADDR OF DATUM TABLE
XX	(LKSTAT,0,INTERNAL)	;STATUS OF GLOBAL LEAP MODEL INTERLOCK (SHOULD BE IN GOGTAB
XX	(INFTB,0,INTERNAL)	;POINT  9,ADDRESS INFOTAB TABLE(3)
XX	(.SKIP.,0,INTERNAL)	;RECORD AUX RESULTS OF RUNTIMES
XX	(RPGSW,0,INTERNAL)	;SET IF (JOBSA)+1 USED TO START
XX	(%RENSW,0,INTERNAL)	;SET IF USER WANTS TO RENTER FOR ALLOC
XX	(CONFIG,0,INTERNAL)	;0 FOR RUNTIME, <0 FOR COMPILER
XX	(.ERRP.,0,INTERNAL)	;PLACE FOR USER TO PUT AN ERROR PROCEDURE
XX	(.ERRJ.,0,INTERNAL)	;TRANSFER ADDRESS RETURNED BY USER PROC.
XX	(%ERRC,0,INTERNAL)	;COMMUNICATION BETWEEN USERRR AND ERROR UUO.
XX	(%RECOV,0,INTERNAL)	;HIGH ORDER BIT ON IF ERROR RECOVERABLE
XX	(%ERGO,0,INTERNAL)	;SET IF IN CONTINUATION MODE.
XX	(.ERSTP,0,INTERNAL)	;POINTER INTO ERROR STRING.
XX	(.ERSTR,<BLOCK 20>,INTERNAL,20) ;ERROR MESSAGE STRING.
XX	(.DTRT.,0,INTERNAL)	;DDT RETURN ADDRESS
XX	(.EXPINT,0,INTERNAL)	;CORE UUO TRAP ROUTINE ADDRESS (CMU-STYLE)
XX	(.SGCINT,0,INTERNAL)	;STRING GC TRAP ROUTINE ADDRESS (")
XX	(.TRACS,<BLOCK 12>,INTERNAL,12)	;CORE, STRNGC TRAP ROUTINE SAVE ACS
XX	(RUNNER,0,INTERNAL)	;THE CURRENTLY RUNNING PROCESS(IF HAVE THEM)
XX	(INTRPT,0,INTERNAL)	;MASK FOR INTERRUPT POLLING
XX	(PROPS,0,INTERNAL)	;BYTE POINTER FOR ACCESSING PROPS(ITEM) ITEM IN 3
XX	(NOPOLL,0,INTERNAL)	;NEQ 0 MEANS IGNORE CALL TO DDFINT
XX	(DEFSSS,0,INTERNAL)	;DEFAULT S-STACK SIZE -- SET BY MAINPR
XX	(DEFPSS,0,INTERNAL)	;DEFAULT P-STACK SIZE (FOR PROCESSES) -- DITTO
XX	(DEFPRI,0,INTERNAL)	;DEFAULT PRIORITY -- DITTO
XX	(DEFQNT,0,INTERNAL)	;DEFAULT QUANTUM -- DITTO
XX	(OVPCWD,0,INTERNAL)	;SET BY APR INTERRUPT HANDLER (IF ANY)
NOEXPO	<
IFE APRISW <
XX	(XJBCNI,0,INTERNAL)	;JOBCNI TYPE THING FOR MOORER SYS (MOD BY F.WRIGHT)
XX	(XJBTPC,0,INTERNAL)	;JOBTPC THING, ETC
XX	(XJBAPR,0,INTERNAL)	;JOBAPR THING.
>;IFE APRISW
IFN APRISW <
XX	(S15ARE,0)
XX	(S16ARE,0)
XX	(S17ARE,0)
>;IFN APRISW
>;NOEXPO
XX	(XJBENB,0,INTERNAL)	;USED BY APR ENABLER FOR EXPORT SYSTEM
XX	(.ERSTC,0,INTERNAL)		; COUNT OF CHARS LEFT IN .ERSTR
XX	(.ERBWD,0,INTERNAL)	; BYRE(13)CHAR COUNT(23)BUFFER
XX	(RECCHN,0,INTERNAL)	;EVERY RECORD IN THE WORLD GOES ON THIS
XX	(RGCLST,0,INTERNAL)	;LIST OF RECORD MARK ROUTINES
XX	(.UUOCN,0,INTERNAL)	;LOCATION OF ALTERNATE UUO DISPATCH
XX	(.CORIN,0,INTERNAL)	;SOME SORT OF CORGET TRAP
XX	(.LEPIN,0,INTERNAL)	;LEAP TRAP FOR TIMING TESTS
NRC <
XX	(CLSLNK,0,INTERNAL)	;CLASS LINK HOMED HERE
XX	($CLS.R,0)		;CLASS RING
XX	($CLASS,0,INTERNAL)	;THE "CLASS" CLASS
XX	($CLS.1,0)		;THE "RECRNG" WORD
XX	($CLS.2,0)		;THE "HANDLER" WORD -- SET UP IN INIT
XX	($CLS.3,5)		;"WRDCNT"
XX	($CLS.4,0)		;POINTER TO "TYPARR" -- SET UP IN INIT
XX	($CLS.5,0)		;POINTER TO "TXTARR" -- SET UP IN INIT
XX	(STRCHN,0,INTERNAL)	;USED FOR STRING SUBFIELD CHAIN
>;NRC
NONRC <
XX	(S1PARE,0)
XX	(S2PARE,0)
XX	(S3PARE,0)
XX	(S4PARE,0)
XX	(S5PARE,0)
XX	(S6PARE,0)
XX	(S7PARE,0)
XX	(S8PARE,0)
XX	(S9PARE,0)
>;NONRC
XX	($SPCAR,0,INTERNAL)	;AN ARRAY OF SMALL SPACE DESCRIPTORS USED BY RECS
XX	(S11ARE,0)
XX	(S12ARE,0)
XX	(S13ARE,0)
XX	(S14ARE,0)
GLOB <
XX	(GSPARE,<BLOCK 2>,,2)
>;GLOB
NOGLOB <
XX	(GDATM,0,INTERNAL)	;DUMMY GLOBAL DATUM TABLE SHOULD ALWAYS BE ZERO
GPROPS←GINFTB←GDATM			;DUMMY GLOBAL INFOTAB DITTO
	INTERNAL GINFTB,GPROPS
>;NOGLOB
XX	(STLNK,0,INTERNAL)	;1 ALL STRINGS TIED TOGETHER FOR STRNGC
XX	(SPLNEK,0,INTERNAL)	;2 ALL SPACE REQUESTS (PDLS, ETC.)
XX	(SETLET,0,INTERNAL)	;3 ALL SET VARIABLES TIED TOGETHER
XX	(SGROT,0,INTERNAL)	;4 LIST OF STRNGC SORTER GENERATORS
XX	(KTLNK,0,INTERNAL)	;5 ALL COUNTER BLOCKS
XX	(INILNK,0,INTERNAL)	;7 INITIALIZATION ROUTINES (LPINI ONLY NOW)
XX	(PDLNK,0,INTERNAL)	;LINKED LIST OF ALL PDS
XX	(RBLIST,0,INTERNAL)	;LIST OF RECORD BLOCKS
XX	(BALNK,0,INTERNAL)	;LOADER LINK FOR DEBUGGER INFO
NOUP <
	LINKEND %STLNK,STLNK
	LINKEND	%SPLNK,SPLNEK
	LINKEND	%SETLK,SETLET
	LINKEND	%SGROT,SGROT
	LINKEND	%KTLNK,KTLNK
	LINKEND %INLNK,INILNK
	LINKEND %PDLNK,PDLNK
	LINKEND	%RBLNK,RBLIST
BAIL<
	LINKEND %BALNK,BALNK
>;BAIL
NRC <
	LINKEND %RCLNK,CLSLNK
>;NRC
>;NOUP
SGLK	(%ARRSRT,SGLKBK,INTERNAL);ROUTINE TO COLLECT STRING ARRAYS
SGLK	(%STRMRK)		;ROUTINE TO COLLECT STRING VARIABLES
SGLK	(%SPGC)			;ROUTINE TO COLLECT STRING STACK
XX	(%SPL,<BLOCK $SPREQ-2>,INTERNAL,$SPREQ-2);DUMMY FIXED ADDR STUFF
XX	(%STDLST,<BLOCK 2>,INTERNAL,2) 	 ;BASE OF BUILT-IN REQUESTS
XX	(,<XWD WNTPDP!MINSZ!USRTB,DEFPDS>) ;SYSTEM!PDL (SPECIAL, SEE BELOW)
XX	(,<XWD	[ASCIZ /SYSTEM PDL/],PDL>)
XX	(,<XWD	WNTPDP!USRTB!MINSZ,50>)	 ;STRING STACK
XX	(,<XWD	[ASCIZ /STRING PDL/],SPDL>)
XX	(,<XWD	WNTADR!WNTEND!USRTB!MINSZ,2000>);STRING!SPACE
XX	(,<XWD	[ASCIZ /STRING SPACE/],ST>)
XX	(,0)			;THAT'S ALL
XX	(ALLPDP,<IOWD 40,ALLPDL>,INTERNAL);USED FOR A WHILE DURING ALLOC
XX	(ALLPDL,<BLOCK 40>,INTERNAL,40)	  ;AND IN PROCESS TERMINATION
XX	(%ALLCHR,0,INTERNAL)
XX	(%OCTRET,0,INTERNAL)
XX	(X11,<XWD 1,1>,INTERNAL)
XX	(X22,<XWD 2,2>,INTERNAL)
XX	(X33,<XWD 3,3>,INTERNAL)
XX	(X44,<XWD 4,4>,INTERNAL)
EXPO <
XX	(PPMAX,<BLOCK 3>,INTERNAL,3)	;FOR SCREWY EDITOR LINKAGE
>;EXPO
XX	(APRACS,<BLOCK 20>,INTERNAL,20)	;APR INTERRUPT AC STORAGE
NOTENX<
EXPO <
XX	(OTSTRBF,<BLOCK 20>,INTERNAL,20)	;OUTSTR BUFFER
>;EXPO
>;NOTENX
CMU <	;THIS STUFF USED FOR GAS
XX	(GASCMD,0,INTERNAL)		;IF 0 THEN VIRGIN, SO
XX	(THIS.MOD,0,INTERNAL)		;
>;CMU
TENX <
XX	(CHNTAB,<BLOCK =36>,INTERNAL,=36);SHOULD BE REFERENCED
XX	(LEVTAB,LPC1,INTERNAL)	;ONLY FROM CODE AT STRT IN SAILOR, Q.V.
XX	(,LPC2,)
XX	(,LPC3,)
XX	(LPC1,0,INTERNAL)
XX	(LPC2,0,INTERNAL)
XX	(LPC3,0,INTERNAL)
XX	(JMPCHN,<BLOCK =36>,INTERNAL,=36)
LOW <
EXTERNAL	PSIL1,PSIL2,PSIL3
>;LOW
XX	(PS1ACS,<BLOCK 20>,INTERNAL,20)
XX	(,<JRST PSIL1>,)
XX	(PS2ACS,<BLOCK 20>,INTERNAL,20)
XX	(,<JRST PSIL2>,)
XX	(PS3ACS,<BLOCK 20>,INTERNAL,20)
XX	(,<JRST PSIL3>,)
XX	(JFNTBL,<BLOCK JFNSIZE>,INTERNAL,JFNSIZE)	;JFNs for each channel
XX	(CDBTBL,<BLOCK JFNSIZE>,INTERNAL,JFNSIZE)	;Addr. of chnl data buffer for each chnl
XX	(PRTMP,0,INTERNAL)
XX	(CTLOSW,0,INTERNAL)				;CTRL-O SWITCH
XX	(TTCSVB,0,INTERNAL)				;TENEX emulation of TTCALL
>;TENX
XX	(INIACS,<BLOCK 20>,INTERNAL,20)
LOW<
IFNDEF XTCKLG,<
	EXTERNAL LPINI
LPLK:	0
	LPINI
	0
LINK %INLNK,LPLK
NRC<
	EXTERNAL $RCINI
RCLK:	0
	$RCINI
	0
>;NRC
>;IFNDEF XTCKLG
>;LOW
SUBTTL	Initialization Routines, Data
SUBTTL Sailor, Reent --  Allocation, Main Program Control
NOUP <
INTERNAL SAILOR
↑SAILOR: 0			;JSR to SAILOR
	MOVEM	17,INIACS+17
	MOVEI	17,INIACS
	BLT	17,INIACS+17-1
	JRST	FRSTRT		;GET A SEGMENT, START UP
	LOC	124		;SET UP REENTER ADDRESS
	REENT
	RELOC
↑REENT:	SETOM	%RENSW		;RE-ENTER -- ASK FOR NEW ALLOC
	HRRZ	TEMP,JOBSA	;SAME AS START, OTHERWISE
	JRST	(TEMP)
↑RESTRT:TDZA	TEMP,TEMP	;ESTABLISH OPERATING MODE
	MOVNI	TEMP,1		;RPG MODE
	MOVEM	TEMP,RPGSW	;RECORD IT
FRSTRT:
TENX <
	JSYS	RESET
>;TENX
	JSP	P,.SEG2.	;GET SECOND SEGMENT
STRT:
NOTENX <
	CALL6(RESET)
>;NOTENX
TENX <
EXTERNAL .RESET
EXTERNAL P.FIN
	JSP	P,.RESET	;JSYS RESET, PSI SYSTEM, TTY MODES, FILE BUFFERS
>;TENX
CMU <
GGAS <
	MOVEI	TEMP,0		;
	CALL6	(TEMP,SETUWP)	;
	JRST	[PUUO	3,[ASCIZ /CANNOT CLEAR WRITE PROTECTION/]
		CALL6(EXIT) ];
>;GGAS
>;CMU
	SETZM	GOGTAB		;FORCE CORSER RE-INITIALIZATION
	SETNIT			;GET TEMP STACK, IF NECESSARY
	JSP	16,%ALLOC	;ALLOCATE AREAS
	MOVEI	A,RESTRT	;CHANGE JOBSA AND JOBREN
	HRRM	A,JOBSA		;"S" USES OLD ALLOCATION
	HRLOI	RF,1		;THE VERY OUTER BLOCK
	PUSHJ	P,@SAILOR	;CALL USER PROGRAM
	PUSHJ	P,K.OUT		;WRITE OUT THE COUNTERS
	PUSHJ	P,P.FIN		;CLOSE OUTPUT $PRINT FILE, IF ANY
	TERPRI	<
End of SAIL execution>
NOTENX <
	CALL6	(0,RESET)	;CLEAR THE I/O WORLD
	CALL6	(1,EXIT)	;QUIT QUIETLY
>;NOTENX
TENX <
	JSYS	HALTF
	JRST	.-1	;NO CONTINUATION
>;TENX
SUBTTL	.SEG2. -- Get a second segment
NOTENX <
INTERNAL .SEG2.
.SEG2.:
NOCMU <
LOW <
	SKIPE	JOBHRL		;IS THERE A SEGMENT?
>;LOW
>;NOCMU
CMU <
IFN LOWER!GASSW ,<
GGAS <
	SKIPL	GASCMD		;VIRGIN??
	JRST	GASSET		;YES, DO SOMETHING ABOUT THAT
>;GGAS
	SKIPN	A,JOBHRL	;ALSO CHECK FOR -1,,0
	JRST	.+3
	CAME	A,[XWD -1,0]	;
>;IFN LOWER!GASSW
>;CMU
	 JRST	 (P)		; YES, GO AHEAD (OR ALWAYS, IF NOLOW)
>;NOTENX
>;NOUP
NOTENX <
NOCMU <
LOW <
SEGTR:				;TRY AGAIN
GLOB <
	SKIPN	%RENSW		;IS LINK-TABLE AND/OR PREVIOUSLY COLLECTED
	 JRST	 SEG3		;NO
 	FOR II IN (SEGDEV,SEGFIL,SEGPPN,NMSAV) <
	SETZM	II
>
	JRST	ASKEM		;CLEAR ALL NON-USER SPECIFIED INFO
SEG3:	SKIPN	B,SPLNEK	;A SPACE BLOCK AROUND??
	 JRST	 ASKEM		; NO
GSGLP:	SKIPE	A,$SGD(B)	;DEVICE REQUEST
	MOVEM	A,SEGDEV
	SKIPE	TEMP,$SGF(B)	;FILE NAME FOR UPPER SEGMENT
	MOVEM	TEMP,SEGFIL
	SKIPE	TEMP,$SGPP(B)	;PPN FOR SAME
	MOVEM	TEMP,SEGPPN
	SKIPE	TEMP,$SGNM(B)	;SEGMENT NAME (UNUSED IN EXPO VERSION)
	MOVEM	TEMP,NMSAV
	SKIPE	B,(B)		;GO DOWN LINKED LIST
	 JRST	 GSGLP		; UNTIL EMPTY
>;GLOB
NOEXPO <
GLOB <
	SKIPE	A,NMSAV		;DID WE GET A SEGMENT?
	 JRST	 GOTEM		; YES, TRY TO LINK TO IT
ASKEM:	SPRINT	<SEGMENT LOGICAL NAME?>
	JSR	GGNAM		;GET A SEGMENT NAME.
GOTEM:	MOVEM	A,NMSAV
>;GLOB
NOGLOB <
	MOVE	A,[FILXXX]	;TRY TO FIND IT.
>;NOGLOB
	CALL6(A,ATTSEG)		;
	SKIPA			;NO LUCK
	JRST	(P)		;OK, DONE
	HRRZ	B,A		;GET FAILURE CODE.
	CAIE	B,1		;AMBIGUITY?
	JRST	GETSE		;NO -- GET THE SEGMENT.
	HLRZS	A
	CALL6(A,ATTSEG)		;
	JSP	A,ERSEG
	JRST	(P)		;OK, GOT IT
>;NOEXPO
EXPO <
ASKEM:				;MISPLACED LABEL
>;EXPO
GETSE:	CALL6(RESET)
GLOB <
	SKIPE	A,SEGFIL	;WAS ONE "REQUIRE"D?
	 JRST	 THSFL		; YES, USE IT
	SPRINT	<SEGMENT FILE NAME?>
	MOVE	A,[FILXXX]	;DEFAULT
	JSR	GGNAM	
THSFL:	MOVEM	A,SEGFIL	;NAME OF SEGMENT.
THSFL1:	SKIPE	A,SEGDEV	;WAS A DEVICE REQUESTED?
	 JRST	 THSDV		; YES
	SPRINT	<DEVICE?>
	MOVE	A,[SGDEVC]	;DEFAULT DEVICE
	JSR	GGNAM
	MOVEM	A,SEGDEV
	CAMN	A,['DSK   ']	;ASK FOR PPN IF DISK
	SKIPE	SEGPPN		;AND PPN=0
	JRST	THSDV		;DON'T ASK, ALREADY THERE
	SPRINT	<PPN?>
	MOVE	A,[SGPPNN]	;DEFAULT PPN
	JSR	GGNAM
	MOVEM	A,SEGPPN
	JRST	THSFL1		;NOW HAVE A DEVICE
THSDV:	MOVEM	A,INTT
	MOVE	A,[XWD SEGDEV,DEVSEG]	;MOVE LOOKUP SPEC IN
	BLT	A,SEGNAM+3
>;GLOB
NOGLOB <
	SETZM	SEGNAM+2
	MOVE	TEMP,[SGPPNN]
	MOVEM	TEMP,SEGNAM+3	;SET UP PPN
	HLLZS	SEGNAM+1
>;NOGLOB
NOEXPO <
	INIT	1,17
INTT:	SGDEVC			;GO GET THE RAW SEGMENT
	0
	JSP	A,ERSEG
	LOOKUP	1,SEGNAM
	JSP	A,ERSEG
	MOVS	A,SEGNAM+3	;WORD COUNT
	HRLM	A,LIOD		;WORD COUNT FOR DUMP MODE.
	MOVNS	A
	HRRO	D,JOBREL	;FOR LATER
	HRRM	D,LIOD		;PLACE TO START DUMP MODE INPUT.
	ADD	A,JOBREL	;TO GET THE AMOUNT OF CORE NEEDED.
	CALL6	(A,CORE)	;CORE UUO ----
	JSP	A,ERSEG
LOP22:	INPUT	1,[LIOD: 0
		    0]
GLOB <
	TLZ	D,-1		;NO, MAKE IT WRITEABLE IF GLOBAL MODEL.
>;GLOB
IFN NOPROT,<
	TLZ	D,-1		;MAKE WRITEABLE IF REQUESTED TO
>;NOPROT NEQ 0
	CALL6	(D,REMAP)	;
NOGLOB <
	JRST	[		;
		CALL6(RESET)	;SINCE A RESET LATER MEANS DISASTER
		PUUO	3,[ ASCIZ/
COULD NOT DO REMAP TO GET A SAIL SEGMENT!
SETPR2 DONE INSTEAD.  YOUR JOB SHOULD BE HAPPY SO LONG AS 
IT DOES NOT DO A RESET OR OTHER BADNESS. GOOD LUCK.
ALSO, IF YOU WANT TO RUN THIS WAY, BEWARE OF RESTARTING.
/]		;BETTER WARN THE POOR PEOPLE
		ADDI	D,2	;MAKE EVEN K & MAKE IT REL MODE
		MOVS	A,SEGNAM+3;
		MOVN	A,A	;SIZE
		ORI	A,1777	;PUTS TO K BNDRY & WRITE PROT
		HRLI	D,(A)	;
		SETPR2	D,	;FAKE THE SEGMENT
		JRST	[ PUUO 3,[ASCIZ/
SETPR2 LOST, TOO!
/]
			JRST	4,1(P)]
		MOVE	A,JOBREL; SINCE SAIL COMPILER IS DUMB
		HRRM	A,JOBFF	; SAFE NOW???
		HRLM	A,JOBSA ; BOTH PLACES (BUFSAV REFERS TO JOBSA)
		JRST	1(P)	;HURRAH -- RETURN
		]
>;NOGLOB
GLOB <
	JSP	A,ERSEG		;GLOBAL CANNOT GET AWAY WITH SETPR2
>;GLOB
NOGLOB <
	MOVE	A,[FILXXX]
>;NOGLOB
GLOB <
	MOVE	A,NMSAV
>;GLOB
	CALL6	(A,SETNM2)	
	JRST	[MOVEI	A,0
		CALL6	(A,CORE2)	;CORE2
	 	 JSP	A,ERSEG
GLOB <
		 SETOM	%RENSW	;FORCE TTY RITUAL
>;GLOB
		 JRST	SEGTR]		;TRY AGAIN.
	CALL6(RESET)
>;NOEXPO
EXPO <
	SETZM	SEGNAM+4		;CLEAR LAST TWO WORDS OF GETSEG BLOCK
	SETZM	SEGNAM+5
	MOVEI	A,DEVSEG		;GET READY
	MOVEM	P,SAVPP
	CALL6	(A,GETSEG)		;GET THE SEGMENT
	 JSP	 A,ERSEG		; COULDN'T
	MOVE	P,SAVPP
>;EXPO
	JRST	(P)			;RETURN
>;LOW
>;NOCMU
CMU <
IFN LOWER!GASSW,<
INTERNAL DEVSEG
SEGTR:					;TRY AGAIN
ASKEM:					;RANDOM LABEL
GETSE:	CALL6(RESET)			;
	SETZM	SEGNAM+2
	MOVE	TEMP,[SGPPNN]
	MOVEM	TEMP,SEGNAM+3	;SET UP PPN
	HLLZS	SEGNAM+1
	SETZM	SEGNAM+4		;CLEAR LAST TWO WORDS OF GETSEG BLOCK
	SETZM	SEGNAM+5
	MOVEI	A,DEVSEG		;GET READY
	MOVEM	P,SAVPP
	CALL6	(A,GETSEG)		;GET THE SEGMENT
	 JSP	 A,ERSEG		; COULDN'T
	MOVE	P,SAVPP
	HRROS	JOBHRL
	JRST	(P)			;RETURN
>;LOW
>;IFN LOWER!GASSW
>;CMU
>;NOTENX
EXPO <
NOUP <
INTERNAL TYPER.,ERRMSG
TYPER.:
ERRMSG:
	JFCL
	ERR	<SOME FORTRAN ROUTINE HAS SEEN FIT TO COMPLAIN
ABOUT YOUR STYLE.  COMPLAIN TO DEC THAT THEIR ERROR MESSAGE
PROCEDURE IS NOT SUFFICIENTLY GENERAL TO ALLOW GRACEFUL INTERFACE
WITH SAIL.>
>;NOUP
>;EXPO
SUBTTL	 Segment-Fetching Data
NOTENX <
NOCMU < ;THESE GUYS HAVE TO BE EXTRA SPECIAL
LOW <
NMSAV:	0			;SAVE LOGICAL SEGMENT NAME HERE
SEGDEV: 0			;SAVE UPPER SEGMENT DEVICE NAME HERE
SEGFIL:	0			;SAVE UPPER SEGMENT FILE NAME HERE
NOEXPO <
	SIXBIT /SEG/		;ALWAYS
>;NOEXPO
EXPO <
	0		;DIFFERENT STROKES FOR ....
>;EXPO
	0
SEGPPN: 0			;SAVE UPPER SEGMENT PPN HERE
DEVSEG:	SGDEVC			;USED ONLY BY EXPO'S GETSEG
SEGNAM:	FILXXX
NOEXPO <
	SIXBIT/SEG/
>;NOEXPO
EXPO <
	0
>;EXPO
	0
	SGPPNN			;SPECIFIED PPN DEFAULT
EXPO <
	0 
	0			;SIX WORD BLOCK FOR GETSEG
SAVPP:	0			;P SAVED HERE OVER GETSEG
>;EXPO
ERSEG:	SPRINT	<SAIL SEGMENT LOADING ERROR
>
GLOB<
	SETOM	%RENSW		;FORCE TTY RITUAL
>;GLOB
	CALL6 (EXIT)
GLOB <
GGNAM:	0
	TTCALL	4,C		;INCHWL.
	CAIE	C,15		;IF NOTHING SPECIFIED,
	MOVEI	A,0		; USE THE DEFAULT
	SKIPA	B,[POINT 6,A]
GGGO:	TTCALL	C		;GET CHAR
	CAIN	C,15
	JRST	[TTCALL C
		 JRST @GGNAM]	;RETURN ON CR.
	CAILE	C,140
	SUBI	C,40		;CONVERT LOWER CASE.
	SUBI	C,40		; CNVRT TO  SIXBIT
	IDPB	C,B		;SAVE IT.
	JRST	GGGO
>;GLOB
>;LOW
>;NOCMU
CMU <
IFN LOWER!GASSW,<
NMSAV:	0			;SAVE LOGICAL SEGMENT NAME HERE
SEGDEV: 0			;SAVE UPPER SEGMENT DEVICE NAME HERE
SEGFIL:	0			;SAVE UPPER SEGMENT FILE NAME HERE
	0		;DIFFERENT STROKES FOR ....
	0
SEGPPN: 0			;SAVE UPPER SEGMENT PPN HERE
DEVSEG:	SGDEVC			;USED ONLY BY EXPO'S GETSEG
SEGNAM:	FILXXX
	0
	0
	SGPPNN			;SPECIFIED PPN DEFAULT
	0 
	0			;SIX WORD BLOCK FOR GETSEG
SAVPP:	0			;P SAVED HERE OVER GETSEG
ERSEG:	SPRINT	<SAIL SEGMENT LOADING ERROR
>
	CALL6 (EXIT)
GGAS <	;COME HERE WHEN STARTING VIRGINALLY
	EXTERNAL %FIRLOC,TOP2
GASSET:	SKIPE	GASCMD		;NORMAL?
	JRST	GASPEC		;NO
	HRROS	JOBHRL		;SO THE HISEG WON'T BE SAVED
	SETOM	GASCMD		;SO WE WON'T DO THIS SILLINESS AGAIN
	TERPRI	<SAVE me>
	CALL6	(0,EXIT)
GASPEC:	SKIPE	TOP2		;HAVE WE BEEN HERE BEFORE?
	JRST	(P)		;YES
	MOVEI	A,0
	CALLI	A,36		;CLEAR WRITE PROTECT
	JRST	[TERPRI <CAN'T WRITE ENABLE 2D SEG>
		CALLI 1,12]
	SETZM	%FIRLOC+11	;NO 2D SEGMENT SYMBOL TABLE
	HLRZ	A,JOBHRL
	MOVEI	A,-%FIRLOC-1(A)
	TRO	A,400000	;TURN IT OFF.
	HRRZM	A,TOP2
	JRST	(P)
>;GGAS
>;IFN LOWER!GASSW
>;CMU
>;NOTENX
TENX <
NOUP <
INTERNAL .SEG2.
.SEG2.:	MOVE	1,[XWD 400000,SEGPAG]	;THIS FORK←←400000
	JSYS	RPACS
	TLNE	2,10000			;DOES THE PAGE FOR THE SEGMENT EXIST?	
	 JRST	(P)			;YES
	MOVEI	1,400000		;THIS FORK
	JSYS	GEVEC			;GET ENTRY VECTOR
	MOVEM	2,3			;SAVE IT
	HRLZI	1,100001
	HRROI	2,[FILXXX]
	JSYS	GTJFN
	  JRST	[HRROI	1,[ASCIZ/SAIL segment loading error on segment:
/]
		 JSYS	PSOUT
		 HRROI	1,[FILXXX]
		 JSYS 	PSOUT
		 HRROI	1,[ASCIZ/
/]
		 JSYS	PSOUT
	HLTAGN:	 JSYS HALTF
		 JRST HLTAGN		;NO CONTINUATION
		]
	HRLI	1,400000
	JSYS	GET
	MOVEI	1,400000		;THIS FORK
	MOVEM	3,2
	JSYS	SEVEC
	JRST	(P)
>;NOUP
>;TENX
ENDCOM(LOR)
END